home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Nibble Magazine
/
nib11.dsk
/
PRICE DEMO.bas
< prev
next >
Wrap
BASIC Source File
|
2023-02-26
|
5KB
|
129 lines
1 REM **********************
2 REM * PRICE DEMO *
3 REM * BY CHRIS EXNER *
4 REM * COPYRIGHT (C) 1982 *
5 REM * BY MICRO-SPARC INC *
6 REM * LINCOLN, MA. 01773 *
7 REM **********************
100 TEXT :D$ = CHR$(4)
200 PRINT D$"OPEN PRICE LIST,L40"
300 ONERR GOTO 20000
400 PRINT D$"READ PRICE LIST,R0"
450 INPUT RCDCTR
500 POKE 216,0: PRINT D$
600 REM *** DISPLAY MENU OF CHOICES
700 HOME : PRINT TAB( 10);"** MAIN MENU **"
800 VTAB 7: PRINT "1. ENTER A PRICE RECORD"
900 VTAB 9: PRINT "2. FIND A PRICE RECORD"
1000 VTAB 11: PRINT "3. EXIT PROGRAM"
1100 PRINT D$: VTAB 15: INPUT "YOUR CHOICE: ";C
1200 IF C = 1 THEN GOSUB 2000: GOTO 700
1300 IF C = 2 THEN GOSUB 7000: GOTO 700
1400 IF C < >3 THEN GOTO 1100
1500 PRINT D$"CLOSE PRICE LIST"
1600 END
2000 REM *** ENTER A PRICE RECORD
2100 HOME : PRINT TAB( 10);"** ENTER A RECORD **"
2200 VTAB 7: INPUT "ENTER ITEM NAME: ";NAME$
2300 IF LEN(NAME$) = 0 OR LEN(NAME$) >20 THEN 2200
2400 VTAB 9: INPUT "ENTER ITEM PRICE: ";PRICE$
2500 IF LEN(PRICE$) = 0 OR LEN(PRICE$) >10 THEN 2400
2600 VTAB 22: INPUT "ANY CORRECTIONS?(Y/N) ";ANS$
2700 IF ANS$ < >"Y" AND ANS$ < >"N" THEN 2600
2800 IF ANS$ = "Y" THEN GOTO 2100
2900 GOSUB 8000: REM FIND ROUTINE
3000 IF FOUND = 0 THEN GOTO 4000
3100 REM *** RE-WRITE RECORD
3200 PRINT D$"WRITE PRICE LIST,R";PTR
3300 PRINT NAME$: PRINT PRICE$: PRINT BPTR: PRINT FPTR
3400 REM *** CONTINUE ENTERING RECORD?
3500 PRINT D$: VTAB 22: INPUT "ENTER ANOTHER RECORD?(Y/N) ";ANS$
3600 IF ANS$ < >"Y" AND ANS$ < >"N" THEN 3500
3700 IF ANS$ = "Y" THEN 2100
3800 RETURN
4000 REM *** ENTER A NEW RECORD
4100 REM *** UPDATE THE RECORD COUNTER IN THE HEADER (0) RECORD
4200 PRINT D$"READ PRICE LIST,R0"
4300 INPUT RCDCTR
4400 RCDCTR = RCDCTR +1
4500 PRINT D$"WRITE PRICE LIST,R0"
4600 PRINT RCDCTR
4700 REM *** WRITE NEW RECORD
4800 PRINT D$"WRITE PRICE LIST,R";RCDCTR
4900 PRINT NAME$: PRINT PRICE$: PRINT WBPTR: PRINT WFPTR
5000 REM *** UPDATE POINTERS OF THE RECORDS BETWEEN WHICH THE NEW RECORD FITS
5100 IF WBPTR = 0 THEN GOTO 5600
5200 PRINT D$"READ PRICE LIST,R";WBPTR
5300 INPUT N$,P$,B,F
5400 PRINT D$"WRITE PRICE LIST,R";WBPTR
5500 PRINT N$: PRINT P$: PRINT B: PRINT RCDCTR
5600 IF WFPTR = 0 THEN GOTO 6100
5700 PRINT D$"READ PRICE LIST,R";WFPTR
5800 INPUT N$,P$,B,F
5900 PRINT D$"WRITE PRICE LIST,R";WFPTR
6000 PRINT N$: PRINT P$: PRINT RCDCTR: PRINT F
6100 REM *** UPDATE THE ALPHA INDEX RECORD
6200 NUM = ASC( LEFT$(NAME$,1)) -64
6210 IF NUM <0 THEN NUM = 27
6220 IF NUM >26 THEN NUM = 28
6300 PRINT D$"WRITE PRICE LIST,R";NUM
6400 PRINT RCDCTR
6500 GOTO 3500: REM ASK 'ENTER ANOTHER RECORD' QUESTION
7000 REM *** FIND A PRICE RECORD
7100 HOME : PRINT TAB( 10);"** FIND A PRICE RECORD **"
7200 VTAB 7: INPUT "ENTER ITEM NAME: ";NAME$
7300 GOSUB 8000: REM FIND A RECORD ROUTINE
7400 PRINT D$: IF FOUND = 0 THEN VTAB 10: PRINT "(RECORD NOT FOUND)": GOTO 7700
7500 VTAB 10: PRINT "ITEM: ";RNAME$
7600 VTAB 12: PRINT "PRICE: ";RPRICE$
7700 VTAB 22: INPUT "FIND ANOTHER RECORD?(Y/N) ";ANS$
7800 IF ANS$ < >"Y" AND ANS$ < >"N" THEN GOTO 7700
7850 IF ANS$ = "Y" THEN GOTO 7100
7900 RETURN
8000 REM ** FIND RECORD ROUTINE
8010 REM ** BPTR IS BACKWARD PTR
8020 REM ** FPTR IS FORWARD PTR
8050 FOUND = 0:WBPTR = 0:WFPTR = 0
8060 IF RCDCTR <29 THEN RETURN
8070 L = LEN(NAME$)
8100 REM *** READ APPROPRIATE INDEX RECORD
8200 NUM = ASC( LEFT$(NAME$,1)) -64
8250 IF NUM <1 THEN NUM = 27
8275 IF NUM >26 THEN NUM = 28
8300 PRINT D$"READ PRICE LIST,R";NUM
8400 INPUT PTR
8450 IF PTR = 0 THEN PTR = RCDCTR
8600 REM *** READ RECORDS UNTIL KEY MATCH IS MADE, OR POSITION WHERE RECORD SHOULD BE IS DETERMINED.
8700 PRINT D$"READ PRICE LIST,R";PTR
8800 INPUT RNAME$,RPRICE$,BPTR,FPTR
8900 IF LEFT$(RNAME$,L) = NAME$ THEN FOUND = 1: RETURN
9000 IF LEFT$(RNAME$,L) <NAME$ THEN GOTO 9300
9100 WFPTR = PTR: IF WBPTR < >0 OR BPTR = 0 THEN RETURN
9200 PTR = BPTR: GOTO 8600
9300 WBPTR = PTR: IF WFPTR < >0 OR FPTR = 0 THEN RETURN
9400 PTR = FPTR: GOTO 8600
20000 REM *** CREATE A NEW FILE.
20010 REM RECORD 0 CONTAINS
20020 REM THE NUMBER OF RECORDS
20030 REM IN THE FILE.
20040 REM RECORD 1-28 ARE THE
20050 REM INDEX CONTAINING
20060 REM THE RECORD POINTERS TO
20070 REM RECORDS OF THE APPROPRIATE
20080 REM KEY. INDEX RECORD 1 POINTS
20090 REM TO A RECORD WHOSE KEY
20100 REM BEGINS WITH "A"; INDEX 2
20110 REM POINTS TO A "B" RECORD ETC.
20120 REM RECORD 29 AND UP ARE
20130 REM DATA RECORDS.
20200 PRINT D$"CLOSE PRICE LIST"
20250 HOME : VTAB 7: PRINT "CREATING PRICE LIST..."
20300 PRINT D$"OPEN PRICE LIST,L40"
20400 FOR I = 1 TO 28
20500 PRINT D$"WRITE PRICE LIST,R";I
20600 PRINT 0
20700 NEXT I
20750 RCDCTR = 28
20800 PRINT D$"WRITE PRICE LIST,R0"
20900 PRINT RCDCTR
21000 GOTO 500: REM RETURN TO MAIN MENU